home *** CD-ROM | disk | FTP | other *** search
- (*===========================================================================*)
- (* Capture control *)
- (* *)
- (* Copyright 1988, 1989, 1991 by H. Roy Engehausen. All rights reserved. *)
- (* *)
- (*===========================================================================*)
-
- {$O+}
-
- UNIT BBCAPTUR;
-
- INTERFACE
-
- PROCEDURE capture_session(cmd_string : STRING);
- PROCEDURE capture_close;
- PROCEDURE capture_window (cmd_string : STRING);
-
- IMPLEMENTATION
-
- USES
- DOS,
- bbdummy,
- bbmdata,
- bbmess,
- bbmisc5,
- bbsdata,
- bbstr,
- bbwin;
-
- CONST
- window_names : STRING[24] = 'CONNECT MONITOR OPERATOR';
-
- (*===========================================================================*)
- (* Capture a session *)
- (*===========================================================================*)
-
- PROCEDURE capture_session(cmd_string : STRING);
-
- VAR
- i : INTEGER;
- t_word : STRING[10];
- win_no : BYTE;
- word_count : BYTE;
-
- BEGIN;
-
- upcase_str_var(cmd_string);
-
- word_count := words(cmd_string);
-
- IF word_count = 1 THEN
- BEGIN;
-
- IF capture_this_window = $FF THEN
- BEGIN;
- send_tnc_data_str('No capture session is active' + cr);
- active_tcb^.error_sw := TRUE;
- EXIT;
- END;
-
- cmd_string := '============== Capture of '
- + subword(@window_names, capture_this_window, 1)
- + ' ended at ' + todays_date_time
- + ' ==============';
-
- capture_this_window := $FF;
-
- WRITELN(capture_file, cmd_string);
-
- send_tnc_data_str(cmd_string+ cr);
-
- CLOSE(capture_file);
-
- EXIT;
-
- END;
-
- IF word_count < 3 THEN
- BEGIN;
- send_message(message_not_en);
- active_tcb^.error_sw := TRUE;
- EXIT;
- END;
-
- IF word_count > 3 THEN
- BEGIN;
- send_message(message_err_wrd);
- active_tcb^.error_sw := TRUE;
- EXIT;
- END;
-
- t_word := subword(@cmd_string, 2, 1);
-
- win_no := find(@window_names, @t_word);
-
- IF win_no = 0 THEN
- BEGIN;
- send_tnc_data_str('Invalid window name' + cr);
- active_tcb^.error_sw := TRUE;
- EXIT;
- END;
-
- cmd_string := subword(@cmd_string, 3, 1);
-
- ASSIGN(capture_file, cmd_string);
-
- {$I-}
- APPEND(capture_file);
- {$I+}
- i := IORESULT;
-
- IF i = 2 THEN
- BEGIN;
- send_tnc_data_str('***** Opening new file for capture *****' + cr);
- {$I-}
- REWRITE(capture_file);
- {$I+}
- i := IORESULT;
- END;
-
- IF i <> 0 THEN
- BEGIN;
- send_tnc_data_str(dos_err_message(i) + cr);
- active_tcb^.error_sw := TRUE;
- EXIT;
- END;
-
- cmd_string := '============== Capture of '
- + subword(@window_names, win_no, 1)
- + ' started at ' + todays_date_time
- + ' ==============';
-
- send_tnc_data_str(cmd_string + cr);
-
- WRITELN(capture_file, cmd_string);
-
- capture_this_window := win_no;
-
- END;
-
- (*===========================================================================*)
- (* Capture a window *)
- (*===========================================================================*)
-
- PROCEDURE capture_window (cmd_string : STRING);
-
- VAR
- i : INTEGER;
- out_count : WORD;
- t_word : STRING[10];
- win_file : TEXT;
- win_no : BYTE;
- word_count : BYTE;
- work_ptr : window_data_ptr;
-
- BEGIN;
-
- upcase_str_var(cmd_string);
-
- word_count := words(cmd_string);
-
- IF word_count < 3 THEN
- BEGIN;
- send_message(message_not_en);
- active_tcb^.error_sw := TRUE;
- EXIT;
- END;
-
- IF word_count > 3 THEN
- BEGIN;
- send_message(message_err_wrd);
- active_tcb^.error_sw := TRUE;
- EXIT;
- END;
-
- t_word := subword(@cmd_string, 2, 1);
-
- win_no := find(@window_names, @t_word);
-
- IF win_no = 0 THEN
- BEGIN;
- send_tnc_data_str('Invalid window name' + cr);
- active_tcb^.error_sw := TRUE;
- EXIT;
- END;
-
- cmd_string := subword(@cmd_string, 3, 1);
-
- ASSIGN(win_file, cmd_string);
-
- {$I-}
- APPEND(win_file);
- {$I+}
- i := IORESULT;
-
- IF i = 2 THEN
- BEGIN;
- send_tnc_data_str('***** Opening new file for window capture *****'
- + cr);
- {$I-}
- REWRITE(win_file);
- {$I+}
- i := IORESULT;
- END;
-
- IF i <> 0 THEN
- BEGIN;
- send_tnc_data_str(dos_err_message(i) + cr);
- active_tcb^.error_sw := TRUE;
- EXIT;
- END;
-
- cmd_string := '============== Capture of '
- + subword(@window_names, win_no, 1)
- + ' done at ' + todays_date_time
- + ' ==============';
-
- send_tnc_data_str(cmd_string + cr);
-
- WRITELN(win_file, cmd_string);
-
- out_count := 0;
-
- WITH window_array[win_no] DO
- BEGIN;
- work_ptr := window_last;
- IF work_ptr <> NIL THEN
- BEGIN;
- WHILE work_ptr^.last_line <> NIL DO
- work_ptr := work_ptr^.last_line;
- END;
- WHILE work_ptr <> NIL DO
- BEGIN;
- INC(out_count);
- WRITELN(win_file, work_ptr^.this_line);
- work_ptr := work_ptr^.next_line;
- END;
- END;
-
- CLOSE(win_file);
-
- STR(out_count, t_word);
-
- send_tnc_data_str(t_word + ' data records written.' + cr);
-
- END;
-
- (*===========================================================================*)
- (* Close captures *)
- (*===========================================================================*)
-
- PROCEDURE capture_close;
- VAR
- t : STRING;
-
- BEGIN;
-
- t := 'GC';
-
- IF capture_this_window <> $FF THEN
- capture_session(t);
-
- END;
-
- END.